home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / kcl / akcl / akcl1615.lha / doc / dbl.el < prev    next >
Lisp/Scheme  |  1991-12-19  |  16KB  |  482 lines
  1. ;; Run akcl under Emacs
  2. ;; Author: W. Schelter, University of Texas
  3. ;;     wfs@rascal.ics.utexas.edu
  4. ;; Rewritten by rms.
  5.  
  6. ;; Some ideas are due to  Masanobu. 
  7.  
  8. ;; This file is part of GNU Emacs.
  9. ;; Copyright (C) 1988 Free Software Foundation, Inc.
  10.  
  11. ;; GNU Emacs is distributed in the hope that it will be useful, but
  12. ;; WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility
  13. ;; to anyone for the consequences of using it or for whether it serves
  14. ;; any particular purpose or works at all, unless he says so in writing.
  15. ;; Refer to the GNU Emacs General Public License for full details.
  16.  
  17. ;; Everyone is granted permission to copy, modify and redistribute GNU
  18. ;; Emacs, but only under the conditions described in the GNU Emacs
  19. ;; General Public License.  A copy of this license is supposed to have
  20. ;; been given to you along with GNU Emacs so you can know your rights and
  21. ;; responsibilities.  It should be in a file named COPYING.  Among other
  22. ;; things, the copyright notice and this notice must be preserved on all
  23. ;; copies.
  24.  
  25. ;; Description of DBL interface:
  26.  
  27. ;; A facility is provided for the simultaneous display of the source code
  28. ;; in one window, while using dbl to step through a function in the
  29. ;; other.  A small arrow in the source window, indicates the current
  30. ;; line.
  31.  
  32. ;; Starting up:
  33.  
  34. ;; In order to use this facility, invoke the command DBL to obtain a
  35. ;; shell window with the appropriate command bindings.  You will be asked
  36. ;; for the name of a file to run.  Dbl will be invoked on this file, in a
  37. ;; window named *dbl-foo* if the file is foo.
  38.  
  39. ;; M-s steps by one line, and redisplays the source file and line.
  40.  
  41. ;; You may easily create additional commands and bindings to interact
  42. ;; with the display.  For example to put the dbl command next on \M-n
  43. ;; (def-dbl next "\M-n")
  44.  
  45. ;; This causes the emacs command dbl-next to be defined, and runs
  46. ;; dbl-display-frame after the command.
  47.  
  48. ;; dbl-display-frame is the basic display function.  It tries to display
  49. ;; in the other window, the file and line corresponding to the current
  50. ;; position in the dbl window.  For example after a dbl-step, it would
  51. ;; display the line corresponding to the position for the last step.  Or
  52. ;; if you have done a backtrace in the dbl buffer, and move the cursor
  53. ;; into one of the frames, it would display the position corresponding to
  54. ;; that frame.
  55.  
  56. ;; dbl-display-frame is invoked automatically when a filename-and-line-number
  57. ;; appears in the output.
  58.  
  59.  
  60. (require 'shell)
  61. (require 'akcl)
  62.  
  63. (defvar dbl-prompt-pattern "\\(^(.*gdb[+]*) *\\)\\|\\(^[^#$%>]*[#$%>]+ *\\)"
  64.   "A regexp to recognize the prompt for dbl or dbl+.") 
  65.  
  66. (defvar dbl-mode-map nil
  67.   "Keymap for dbl-mode.")
  68.  
  69. (if dbl-mode-map
  70.    nil
  71.   (setq dbl-mode-map (copy-keymap shell-mode-map))
  72.   (define-key dbl-mode-map "\C-cl" 'dbl-find-line)
  73.   )
  74.  
  75. (define-key ctl-x-map " " 'dbl-break)
  76. ;(define-key ctl-x-map "&" 'send-dbl-command)
  77.  
  78. ;;Of course you may use `def-dbl' with any other dbl command, including
  79. ;;user defined ones.   
  80.  
  81. (defmacro def-dbl (name key &optional doc)
  82.   (let* ((fun (intern (format "dbl-%s" name)))
  83.      (cstr (list 'if '(not (= 1 arg))
  84.              (list 'format "%s %s" name 'arg)
  85.              name)))
  86.     (list 'progn
  87.        (list 'defun fun '(arg)
  88.         (or doc "")
  89.         '(interactive "p")
  90.         (list 'dbl-call cstr))
  91.       (list 'define-key 'dbl-mode-map key  (list 'quote fun)))))
  92.  
  93. (def-dbl ":step"   "\M-s" "Step one source line with display")
  94. (def-dbl ":step"  "\M-i" "Step one instruction with display")
  95. (def-dbl ":next"   "\M-n" "Step one source line (skip functions)")
  96. (def-dbl ":r"   "\M-c" "Continue with display")
  97.  
  98. (def-dbl "finish" "\C-c\C-f" "Finish executing current function")
  99. (def-dbl ":up"     "\M-u"   "Go up N stack frames (numeric arg) with display")
  100. (def-dbl ":down"   "\M-d"   "Go down N stack frames (numeric arg) with display")
  101.  
  102.  
  103. (defun dbl-mode ()
  104.   "Major mode for interacting with an inferior Dbl process.
  105. The following commands are available:
  106.  
  107. \\{dbl-mode-map}
  108.  
  109. \\[dbl-display-frame] displays in the other window
  110. the last line referred to in the dbl buffer.
  111.  
  112. \\[dbl-:step] and \\[dbl-:next] in the dbl window,
  113. call dbl to step and next and then update the other window
  114. with the current file and position.
  115.  
  116. If you are in a source file, you may select a point to break
  117. at, by doing \\[dbl-break].
  118.  
  119. Commands:
  120. Many commands are inherited from shell mode. 
  121. Additionally we have:
  122.  
  123. \\[dbl-display-frame] display frames file in other window
  124. \\[dbl-:step] advance one line in program
  125. \\[dbl-:next] advance one line in program (skip over calls).
  126. \\[send-dbl-command] used for special printing of an arg at the current point.
  127. C-x SPACE sets break point at current line."
  128.   (interactive)
  129.   (kill-all-local-variables)
  130.   (setq major-mode 'dbl-mode)
  131.   (setq mode-name "Inferior Dbl")
  132.   (setq mode-line-process '(": %s"))
  133.   (use-local-map dbl-mode-map)
  134.   (make-local-variable 'last-input-start)
  135.   (setq last-input-start (make-marker))
  136.   (make-local-variable 'last-input-end)
  137.   (setq last-input-end (make-marker))
  138.   (make-local-variable 'dbl-last-frame)
  139.   (setq dbl-last-frame nil)
  140.   (make-local-variable 'dbl-last-frame-displayed-p)
  141.   (setq dbl-last-frame-displayed-p t)
  142.   (make-local-variable 'dbl-delete-prompt-marker)
  143.   (setq dbl-delete-prompt-marker nil)
  144.   (make-local-variable 'dbl-filter-accumulator)
  145.   (setq dbl-filter-accumulator nil)
  146.   (make-local-variable 'shell-prompt-pattern)
  147.   (setq shell-prompt-pattern dbl-prompt-pattern)
  148.   (run-hooks 'shell-mode-hook 'dbl-mode-hook))
  149.  
  150. (defvar current-dbl-buffer nil)
  151.  
  152. (defvar dbl-command-name "/bin/csh"
  153.   "Pathname for executing dbl.")
  154.  
  155.  
  156. (defun dbl (arg)
  157.   " makes a dbl buffer, suitable for running an inferior akcl.
  158.  It has special keybindings for stepping and viewing sources.
  159.  Once in the buffer invoke the lisp.   Enter the debug loop with
  160.  (si::dbl) or :dbl in a debug loop.
  161. " (interactive "sName: ")
  162.   (let ((file arg) tem
  163.     (dir default-directory))
  164.     (switch-to-buffer (concat "*dbl-" file "*"))
  165.     (setq default-directory
  166.       (if (and (setq tem (file-name-directory file))
  167.            (file-directory-p  tem))
  168.           tem    dir))
  169.     (or (bolp) (newline))
  170.     (insert "Current directory is " default-directory "\n")
  171.     (make-shell (concat "dbl-" file) dbl-command-name nil )
  172.     (dbl-mode)
  173.     (set-process-filter (get-buffer-process (current-buffer)) 'dbl-filter)
  174.     (set-process-sentinel (get-buffer-process (current-buffer)) 'dbl-sentinel)
  175.     (dbl-set-buffer)))
  176.  
  177. (defun dbl-set-buffer ()
  178.   (cond ((eq major-mode 'dbl-mode)
  179.     (setq current-dbl-buffer (current-buffer)))))
  180.  
  181. ;; This function is responsible for inserting output from DBL
  182. ;; into the buffer.
  183. ;; Aside from inserting the text, it notices and deletes
  184. ;; each filename-and-line-number;
  185. ;; that DBL prints to identify the selected frame.
  186. ;; It records the filename and line number, and maybe displays that file.
  187. (defun dbl-filter (proc string)
  188.   (let ((inhibit-quit t))
  189.     (if dbl-filter-accumulator
  190.     (dbl-filter-accumulate-marker proc
  191.                       (concat dbl-filter-accumulator string))
  192.     (dbl-filter-scan-input proc string))))
  193.  
  194. (defun dbl-filter-accumulate-marker (proc string)
  195.   (setq dbl-filter-accumulator nil)
  196.   (if (> (length string) 1)
  197.       (if (= (aref string 1) ?\032)
  198.       (let ((end (string-match "\n" string)))
  199.         (if end
  200.         (progn
  201.           (let* ((first-colon (string-match ":" string 2))
  202.              (second-colon
  203.               (string-match ":" string (1+ first-colon))))
  204.             (setq dbl-last-frame
  205.               (cons (substring string 2 first-colon)
  206.                 (string-to-int
  207.                  (substring string (1+ first-colon)
  208.                         second-colon)))))
  209.           (setq dbl-last-frame-displayed-p nil)
  210.           (dbl-filter-scan-input proc
  211.                      (substring string (1+ end))))
  212.           (setq dbl-filter-accumulator string)))
  213.     (dbl-filter-insert proc "\032")
  214.     (dbl-filter-scan-input proc (substring string 1)))
  215.     (setq dbl-filter-accumulator string)))
  216.  
  217. (defun dbl-filter-scan-input (proc string)
  218.   (if (equal string "")
  219.       (setq dbl-filter-accumulator nil)
  220.       (let ((start (string-match "\032" string)))
  221.     (if start
  222.         (progn (dbl-filter-insert proc (substring string 0 start))
  223.            (dbl-filter-accumulate-marker proc
  224.                          (substring string start)))
  225.         (dbl-filter-insert proc string)))))
  226.  
  227. (defun dbl-filter-insert (proc string)
  228.   (let ((moving (= (point) (process-mark proc)))
  229.     (output-after-point (< (point) (process-mark proc)))
  230.     (old-buffer (current-buffer))
  231.     start)
  232.     (set-buffer (process-buffer proc))
  233.     (unwind-protect
  234.     (save-excursion
  235.       ;; Insert the text, moving the process-marker.
  236.       (goto-char (process-mark proc))
  237.       (setq start (point))
  238.       (insert string)
  239.       (set-marker (process-mark proc) (point))
  240.       (dbl-maybe-delete-prompt)
  241.       ;; Check for a filename-and-line number.
  242.       (dbl-display-frame
  243.        ;; Don't display the specified file
  244.        ;; unless (1) point is at or after the position where output appears
  245.        ;; and (2) this buffer is on the screen.
  246.        (or output-after-point
  247.            (not (get-buffer-window (current-buffer))))
  248.        ;; Display a file only when a new filename-and-line-number appears.
  249.        t)
  250.       (goto-char (point-max))
  251.  
  252.       )
  253.       (set-buffer old-buffer))
  254.     (if moving (goto-char (process-mark proc)))))
  255. (setq me nil)
  256. (defun dbl-sentinel (proc msg)
  257.   (cond ((null (buffer-name (process-buffer proc)))
  258.      ;; buffer killed
  259.      ;; Stop displaying an arrow in a source file.
  260.      (setq overlay-arrow-position nil)
  261.      (set-process-buffer proc nil))
  262.     ((memq (process-status proc) '(signal exit))
  263.      ;; Stop displaying an arrow in a source file.
  264.      (setq overlay-arrow-position nil)
  265.      ;; Fix the mode line.
  266.      (setq mode-line-process
  267.            (concat ": "
  268.                (symbol-name (process-status proc))))
  269.      (let* ((obuf (current-buffer)))
  270.        ;; save-excursion isn't the right thing if
  271.        ;;  process-buffer is current-buffer
  272.        (unwind-protect
  273.            (progn
  274.          ;; Write something in *compilation* and hack its mode line,
  275.          (set-buffer (process-buffer proc))
  276.          ;; Force mode line redisplay soon
  277.          (set-buffer-modified-p (buffer-modified-p))
  278.          (if (eobp)
  279.              (insert ?\n mode-name " " msg)
  280.            (save-excursion
  281.              (goto-char (point-max))
  282.              (insert ?\n mode-name " " msg)))
  283.          ;; If buffer and mode line will show that the process
  284.          ;; is dead, we can delete it now.  Otherwise it
  285.          ;; will stay around until M-x list-processes.
  286.          (delete-process proc))
  287.          ;; Restore old buffer, but don't restore old point
  288.          ;; if obuf is the dbl buffer.
  289.          (set-buffer obuf))))))
  290.  
  291.  
  292. (defun dbl-refresh ()
  293.   "Fix up a possibly garbled display, and redraw the arrow."
  294.   (interactive)
  295.   (redraw-display)
  296.   (dbl-display-frame))
  297.  
  298. (defun dbl-display-frame (&optional nodisplay noauto)
  299.   "Find, obey and delete the last filename-and-line marker from DBL.
  300. The marker looks like \\032\\032FILENAME:LINE:CHARPOS\\n.
  301. Obeying it means displaying in another window the specified file and line."
  302.   (interactive)
  303.   (dbl-set-buffer)
  304.   (and dbl-last-frame (not nodisplay)
  305.        (or (not dbl-last-frame-displayed-p) (not noauto))
  306.        (progn (dbl-display-line (car dbl-last-frame) (cdr dbl-last-frame))
  307.           (setq dbl-last-frame-displayed-p t))))
  308.  
  309.          
  310. ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
  311. ;; and that its line LINE is visible.
  312. ;; Put the overlay-arrow on the line LINE in that buffer.
  313.  
  314.  
  315.  
  316. (defun dbl-find-file (file)
  317.   (cond ((file-exists-p file)
  318.      (find-file-noselect file))
  319.     ((get-buffer file))
  320.     (t (find-file-noselect file))))
  321.  
  322. (defvar dbl-dirs  nil)
  323.  
  324. (defun search-path (file dirs)
  325.   (let ((paths (symbol-value dirs))
  326.     true-file)
  327.     (cond ((file-exists-p file) (setq true-file file))
  328.       (t
  329.        (while paths
  330.          (let ((tem (expand-file-name file (or (car paths) default-directory))))
  331.            (if  (file-exists-p tem) (setq true-file tem))
  332.            (setq paths (cdr paths))))))
  333.    
  334.    (cond (true-file)
  335.      (t (setq paths (symbol-value dirs))
  336.       (set dirs
  337.           (append paths
  338.               (list (file-name-directory
  339.                  (read-file-name
  340.                   (format "%s = %s, add path :" dirs paths))))))
  341.          (search-path file dirs)))))
  342.  
  343. (defun dbl-find-line ()
  344.   (interactive)
  345.   (save-excursion
  346.     (end-of-line)
  347.     (cond ((re-search-backward "[a-zA-Z] line [0-9]+)" 300 nil)
  348.        (let (at)  
  349.          (setq at (point))
  350.          (forward-char 1)
  351.          (forward-sexp 1)
  352.          (setq line (read (current-buffer)))
  353.          (search-backward "(")
  354.          (setq file  (buffer-substring (+ 1 (point)) (+ 1 at)))
  355.          (and (integerp line)
  356.           (setq file (search-path file 'dbl-dirs))
  357.           (dbl-display-line
  358.            file line)))))))
  359.            
  360.     
  361. (defun dbl-display-line (true-file line)
  362.   (let* ((buffer (dbl-find-file true-file))
  363.      (window (display-buffer buffer t))
  364.      (pos))
  365.     (save-excursion
  366.       (set-buffer buffer)
  367.       (save-restriction
  368.     (widen)
  369.     (goto-line line)
  370.     (setq pos (point))
  371.     (setq overlay-arrow-string "=>")
  372.     (or overlay-arrow-position
  373.         (setq overlay-arrow-position (make-marker)))
  374.     (set-marker overlay-arrow-position (point) (current-buffer)))
  375.       (cond ((or (< pos (point-min)) (> pos (point-max)))
  376.          (widen)
  377.          (goto-char pos))))
  378.     (set-window-point window overlay-arrow-position)))
  379.  
  380. (defun dbl-call (command)
  381.   "Invoke dbl COMMAND displaying source in other window."
  382.   (interactive)
  383.   (goto-char (point-max))
  384.   (setq dbl-delete-prompt-marker (point-marker))
  385.   (dbl-set-buffer)
  386.   (send-string (get-buffer-process current-dbl-buffer)
  387.            (concat command "\n")))
  388.  
  389. (defun dbl-maybe-delete-prompt ()
  390.   (if (and dbl-delete-prompt-marker
  391.        (> (point-max) (marker-position dbl-delete-prompt-marker)))
  392.       (let (start)
  393.     (goto-char dbl-delete-prompt-marker)
  394.     (setq start (point))
  395.     (beginning-of-line)
  396.     (delete-region (point) start)
  397.     (setq dbl-delete-prompt-marker nil))))
  398.  
  399. (defun dbl-break ()
  400.   "Set DBL breakpoint at this source line."
  401.   (interactive)
  402.   (cond ((eq major-mode 'lisp-mode)
  403.      (save-excursion
  404.        (end-of-line)
  405.        (let (name
  406.          at where)
  407.          (setq where (point))
  408.          (mark-defun)
  409.          (search-forward "(def")
  410.          (forward-sexp 2)
  411.          (setq at (point))
  412.          (forward-sexp -1)
  413.          (setq name (buffer-substring (point) at))
  414.          (beginning-of-line)
  415. ;         (setq at
  416. ;           (progn (re-search-forward "^[^;\"\n]+([a-zA-Z ]" (mark) t)
  417. ;              (forward-char -2)
  418. ;              (point)))
  419.          (setq name (format "(si::break-function '%s %s t)"  name (count-lines 1 where)))
  420.          (other-window 1)
  421.          (if (get-buffer-process (current-buffer))
  422.          (setq current-dbl-buffer (current-buffer)))
  423.          (other-window 1)
  424.          (message name)
  425.          (send-string (get-buffer-process current-dbl-buffer)
  426.               (concat name "\n")))))
  427.     (t
  428.   
  429.      (let ((file-name (file-name-nondirectory buffer-file-name))
  430.            (line (save-restriction
  431.                (widen)
  432.                (1+ (count-lines 1 (point))))))
  433.        (send-string (get-buffer-process current-dbl-buffer)
  434.             (concat "break " file-name ":" line "\n"))))))
  435.     
  436.     
  437. (defun dbl-read-address()
  438.   "Return a string containing the core-address found in the buffer at point."
  439.   (save-excursion
  440.    (let ((pt (dot)) found begin)
  441.      (setq found (if (search-backward "0x" (- pt 7) t)(dot)))
  442.      (cond (found (forward-char 2)(setq result
  443.             (buffer-substring found
  444.                  (progn (re-search-forward "[^0-9a-f]")
  445.                     (forward-char -1)
  446.                     (dot)))))
  447.        (t (setq begin (progn (re-search-backward "[^0-9]") (forward-char 1)
  448.                  (dot)))
  449.           (forward-char 1)
  450.           (re-search-forward "[^0-9]")
  451.           (forward-char -1)
  452.           (buffer-substring begin (dot)))))))
  453.  
  454.  
  455. (defvar dbl-commands nil
  456.   "List of strings or functions used by send-dbl-command.
  457. It is for customization by you.")
  458.  
  459. (defun send-dbl-command (arg)
  460.  
  461.   "This command reads the number where the cursor is positioned.  It
  462.  then inserts this ADDR at the end of the dbl buffer.  A numeric arg
  463.  selects the ARG'th member COMMAND of the list dbl-print-command.  If
  464.  COMMAND is a string, (format COMMAND ADDR) is inserted, otherwise
  465.  (funcall COMMAND ADDR) is inserted.  eg. \"p (rtx)%s->fld[0].rtint\"
  466.  is a possible string to be a member of dbl-commands.  "
  467.  
  468.  
  469.   (interactive "P")
  470.   (let (comm addr)
  471.     (if arg (setq comm (nth arg dbl-commands)))
  472.     (setq addr (dbl-read-address))
  473.     (if (eq (current-buffer) current-dbl-buffer)
  474.     (set-mark (point)))
  475.     (cond (comm
  476.        (setq comm
  477.          (if (stringp comm) (format comm addr) (funcall comm addr))))
  478.       (t (setq comm addr)))
  479.     (switch-to-buffer current-dbl-buffer)
  480.     (goto-char (dot-max))
  481.     (insert-string comm)))
  482.